perm filename CL[1,LMM] blob
sn#029050 filedate 1973-03-12 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "12-MAR-73 00:23:49")
T)
(LISPXTERPRI T))
(LISPXPRINT (QUOTE CLVARS)
T)
(RPAQQ CLVARS
((FNS CLDIFF CLCOUNT CLPARTS CLPARTITIONSN CLPARTITIONS
CLCREATE CLINSERT CL=PARTS CLBYVALENCE CLPARTITIONSL
CLEXPAND)
(VARS)))
(DEFINEQ
(CLDIFF
[LAMBDA (CL1 CL2)
(* This function computes the DIFFERENCE of two
composition lists -
Zero terms are eliminated)
(FOR NEW PR IN CL1 AS NEW N IS (IDIFFERENCE (CDR PR)
(LMASSOC (CAR PR)
CL2 0))
WHEN (IGREATERP N 0)
LIST
(CONS (CAR PR)
N])
(CLCOUNT
[LAMBDA (CL) (* This function
computes the number of
elements IN a
composition list)
(FOR NEW PR IN CL IPLUS (CDR PR])
(CLPARTS
[LAMBDA (CL PARTSIZE)
(* This function finds all SUB compositions of the
composition list cl1 which are of SIZE parsizze, and
returns a list of the possibilities -
I.e. (CLPARTS ' ((A . 3) (B . 2)) 2) returns
(((a . 2)) , ((a . 1) (b . 1)),
((b . 2))))
(IF (ZEROP PARTSIZE)
THEN (LIST NIL)
ELSEIF (NULL (CDR CL))
THEN (LIST (LIST (CONS (CAAR CL)
PARTSIZE)))
ELSE (PROG (SIZE)
[SETQ SIZE (IDIFFERENCE PARTSIZE (CLCOUNT
(CDR CL]
(RETURN (FOR NEW X :=((MAX SIZE 1)
(MIN PARTSIZE (CDAR CL))) FOR NEW PART
IN (CLPARTS (CDR CL)
(DIFFERENCE PARTSIZE X))
XLIST FIRST
(IF (LESSP 0 SIZE)
THEN NIL
ELSE (CLPARTS (CDR CL)
PARTSIZE))
(CONS (CONS (CAAR CL)
X)
PART])
(CLPARTITIONSN
[LAMBDA (CL N MINPARTSIZE MAXPARTSIZE)
(* This function finds all partitions of CL into N
parts WHERE each part has a CLCOUNT of at least
MINPARTSIZE and at most MAXPARTSIZE)
(FOR NEW PARTSIZES IN (NUMPARTITIONS (CLCOUNT CL)
N MINPARTSIZE MAXPARTSIZE)
NCONC
(CLPARTITIONS CL PARTSIZES])
(CLPARTITIONS
[LAMBDA (CL PARTSIZES)
(* PARTSIZES IS a list of numbers -
This function finds all partitions of CL into PARTS
WHERE each PART IS of the corresponding SIZE IN
PARTSIZES -
The sum of PARTSIZES must be equal to the CLCOUNT of
CL or ELSE the value will be NIL -
The value IS a list of partitions;
a partition IS a list of composition lists)
(IF (NOT (CDR PARTSIZES))
THEN (LIST (LIST CL))
ELSEIF (ZEROP (CAR PARTSIZES))
THEN [MAPCAR (CLPARTITIONS CL (CDR PARTSIZES))
(FUNCTION (LAMBDA (X)
(CONS NIL X]
ELSEIF (EQUAL (CAR PARTSIZES)
(CADR PARTSIZES))
THEN [PROG (N THISPART)
(SETQ N 1)
(SETQ THISPART (CAR PARTSIZES)
PARTSIZES)
(FOR PARTSIZES ON (CDR PARTSIZES)
WHILE (EQP (CAR PARTSIZES)
THISPART) DO (SETQ N (ADD1 N)))
(IF (NOT PARTSIZES)
THEN (RETURN (CL=PARTS CL N THISPART)))
(RETURN (FOR NEW BIGPART
IN (CLPARTS CL (TIMES N THISPART))
AS NEW RESTPARTSLIST IS
(CLPARTITIONS (CLDIFF CL BIGPART)
PARTSIZES) FOR NEW
LITTLEPARTS
IN (CL=PARTS BIGPART N THISPART)
FOR NEW RESTPARTS
IN RESTPARTSLIST XLIST (APPEND
LITTLEPARTS
RESTPARTS]
ELSE (FOR NEW PART IN (CLPARTS CL (CAR PARTSIZES)) FOR NEW PARTS
IN (CLPARTITIONS (CLDIFF CL PART)
(CDR PARTSIZES))
XLIST
(CONS PART PARTS])
(CLCREATE
[LAMBDA (L)
(* This function takes a list which may have
duplicates, and returns a composition list which
corresponds to it -
I.e. (CLCREATE ' (A A A B B C)) returns
((a . 3) (b . 2) (C . 1)))
(PROG (CL)
(FOR NEW X IN L DO (SETQ CL (CLINSERT X CL)))
(RETURN CL])
(CLINSERT
[LAMBDA (ITEM CL) (* This function returns
the composition list CL
with "ITEM" inserted)
(IF (NOT CL)
THEN (LIST (CONS ITEM 1))
ELSEIF (EQUAL ITEM (CAAR CL))
THEN (REPLACE (CDAR CL)
(ADD1 (CDAR CL)))
CL
ELSEIF (LEQ ITEM (CAAR CL))
THEN (CONS (CONS ITEM 1)
CL)
ELSE (REPLACE (CDR CL)
(CLINSERT ITEM (CDR CL])
(CL=PARTS
[LAMBDA (CL NPARTS PARTSIZE)
(* This function finds all partitions of CL into
NPARTS parts, where every part is of size PARTSIZE -
NPARTS*PARTSIZE must be equal to the CLCOUNT of CL)
(IF (ZEROP NPARTS)
THEN (QUOTE (NIL))
ELSEIF (NOT (CDR CL))
THEN [SETQ CL (AND (NOT (ZEROP PARTSIZE))
(LIST (CONS (CAAR CL)
PARTSIZE]
(LIST (FOR NEW I :=(1 NPARTS)
XLIST CL))
ELSE (FOR NEW X IN (NUMPARTITIONS (CDAR CL)
NPARTS 0 PARTSIZE)
FOR NEW Y
IN (CLPARTITIONS (CDR CL)
(FOR NEW XX IN X LIST (DIFFERENCE
PARTSIZE XX))
)
XLIST
(FOR NEW XX IN X AS NEW YY
IN Y LIST (IF (ZEROP XX)
THEN YY
ELSE (CONS (CONS (CAAR CL)
XX)
YY])
(CLBYVALENCE
[LAMBDA (CL)
(SETQ CL (GROUPBY [FUNCTION (LAMBDA (PR)
(VALENCE (CAR PR]
CL))
(* CL must be a composition list of things with a
VALENCE -
This function returns a list of composition lists;
the first CL contains those things with VALENCE 2 -
The second those with VALENCE 3, and so on)
(FOR NEW I :=[2 (*MAX (MAPCAR CL (FUNCTION CAR]
LIST
(LMASSOC I CL NIL])
(CLPARTITIONSL
[LAMBDA (CL LL) (* Damn if i can
remember what this one
does)
(IF (NOT LL)
THEN (LIST NIL)
ELSE (FOR NEW FP IN (CLPARTS CL (*PLUS (CAR LL)))
AS NEW RPL IS (CLPARTITIONSL (CLDIFF CL FP)
(CDR LL))
FOR NEW TP IN (CLPARTLP1 FP (CAR LL)
1) FOR NEW RP
IN RPL XLIST (CONS TP RP])
(CLEXPAND
[LAMBDA (CL)
(* This function is the inverse of CLCREATE -
It takes a composition list and returns a list with
the appropriate number of copies of each item IN the
composition list -
I.e. (CLEXPAND ' ((A . 3) (B . 2))) gives
(a a a b b))
(FOR NEW X IN CL FOR NEW N :=(1 (CDR X))
LIST
(CAR X])
)
STOP